home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0023_Another Graphic Rotate.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  8KB  |  330 lines
  1. {
  2. SEAN PALMER
  3.  
  4. > I've been trying For some time to get a Pascal Procedure that can
  5. > SCALE and/or ROTATE Graphic images. if anyone has any idea how to do this,
  6. > or has a source code, PLEEEAASSEE drop me a line.. THANK YOU!
  7.  
  8. This is an out-and-out blatant hack of the routines from Abrash's
  9. XSHARP21. They are too slow to be usable as implemented here.
  10. }
  11.  
  12. {$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}
  13. {$M $2000,0,0}
  14. Program VectTest;
  15. Uses
  16.   Crt, b320x200; {<-this Unit just implements Plot(x, y) and Color : Byte; }
  17.  
  18. Const
  19.   ClipMinY = 0;
  20.   ClipMaxY = 199;
  21.   ClipMinX = 0;
  22.   ClipMaxX = 319;
  23.   VertMax  = 3;
  24.  
  25. Type
  26.   fixed = Record
  27.     Case Byte of
  28.       0 : (f : Byte; si : shortint);
  29.       1 : (f2, b : Byte);
  30.       2 : (w : Word);
  31.       3 : (i : Integer);
  32.     end;
  33.  
  34.   ByteArray = Array [0..63999] of Byte;
  35.  
  36.   VertRec   = Record
  37.     X, Y : Byte;
  38.   end;
  39.  
  40.   VertArr   = Array [0..VertMax] Of VertRec;
  41.   EdgeScan  = Record
  42.     scansLeft   : Integer;
  43.     Currentend  : Integer;
  44.     srcX, srcY  : fixed;
  45.     srcStepX,
  46.     srcStepY    : fixed;
  47.     dstX        : Integer;
  48.     dstXIntStep : Integer;
  49.     dstXdir     : Integer;
  50.     dstXErrTerm : Integer;
  51.     dstXAdjUp   : Integer;
  52.     dstXAdjDown : Integer;
  53.     dir         : shortInt;
  54.   end;
  55.  
  56. Const
  57.   numVerts = 4;
  58.   mapX     = 7;
  59.   mapY     = 7;
  60.  
  61.   Vertex : Array [0..vertMax] of vertRec =
  62.     ((x : 040; y : 020),
  63.      (x : 160; y : 050),
  64.      (x : 160; y : 149),
  65.      (x : 040; y : 179));
  66.  
  67.   Points : Array [0..vertMax] of vertRec =
  68.     ((x : 0; y : 0),
  69.      (x : mapX; y : 0),
  70.      (x : mapX; y : mapY),
  71.      (x : 0; y : mapY));
  72.  
  73.   texMap : Array [0..mapY, 0..mapX] of Byte =
  74.     (($F, $F, $F, $F, $F, $F, $F, $0),
  75.      ($F, $7, $7, $7, $7, $7, $F, $0),
  76.      ($F, $7, $2, $2, $2, $7, $F, $0),
  77.      ($F, $7, $2, $2, $2, $7, $F, $0),
  78.      ($F, $7, $2, $2, $9, $7, $F, $0),
  79.      ($F, $7, $2, $2, $2, $7, $F, $0),
  80.      ($F, $7, $2, $2, $2, $7, $F, $0),
  81.      ($0, $0, $0, $0, $0, $0, $0, $0));
  82.  
  83. Var
  84.   lfEdge,
  85.   rtEdge : EdgeScan;
  86.   z, z2  : Integer;
  87.  
  88. Function fixedDiv(d1, d2 : LongInt) : LongInt; Assembler;
  89. Asm
  90.   db  $66; xor dx, dx
  91.   mov cx, Word ptr D1+2
  92.   or  cx, cx
  93.   jns @S
  94.   db  $66; dec dx
  95.  @S:
  96.   mov dx, cx
  97.   mov ax, Word ptr D1
  98.   db  $66; shl ax, 16
  99.   db  $66; idiv Word ptr d2
  100.   db  $66; mov dx, ax
  101.   db  $66; shr dx, 16
  102. end;
  103.  
  104. Function div2Fixed(d1, d2 : LongInt) : LongInt; Assembler;
  105. Asm
  106.   db $66; xor dx, dx
  107.   db $66; mov ax, Word ptr d1
  108.   db $66; shl ax, 16
  109.   jns @S
  110.   db $66; dec dx
  111.  @S:
  112.   db $66; idiv Word ptr d2
  113.   db $66; mov dx, ax
  114.   db $66; shr dx, 16
  115. end;
  116.  
  117. Function divfix(d1, d2 : Integer) : Integer; Assembler;
  118. Asm
  119.   mov  al, Byte ptr d1+1
  120.   cbw
  121.   mov  dx, ax
  122.   xor  al, al
  123.   mov  ah, Byte ptr d1
  124.   idiv d2
  125. end;
  126.  
  127. Procedure Draw;
  128. Var
  129.   MinY,
  130.   MaxY,
  131.   MinVert,
  132.   MaxVert,
  133.   I, dstY  : Integer;
  134.  
  135.   Function SetUpEdge(Var Edge : EdgeScan; StartVert : Integer) : Boolean;
  136.   Var
  137.     NextVert   : shortint;
  138.     dstXWidth  : Integer;
  139.     T,
  140.     dstYHeight : fixed;
  141.   begin
  142.     SetUpEdge := True;
  143.     While (StartVert <> MaxVert) Do
  144.     begin
  145.       NextVert := StartVert + Edge.dir;
  146.       if (NextVert >= NumVerts) Then
  147.         NextVert := 0
  148.       else
  149.       if (NextVert < 0) Then
  150.         NextVert := pred(NumVerts);
  151.  
  152.       With Edge Do
  153.       begin
  154.        scansLeft := vertex[NextVert].Y - vertex[StartVert].Y;
  155.        if (scansLeft <> 0) Then
  156.        begin
  157.          dstYHeight.f  := 0;
  158.          dstYHeight.si := scansLeft;
  159.          Currentend    := NextVert;
  160.          srcX.f  := 0;
  161.          srcX.si := Points[StartVert].X;
  162.          srcY.f  := 0;
  163.          srcY.si := Points[StartVert].Y;
  164.          srcStepX.i := divFix(points[nextVert].x - srcX.si, scansLeft);
  165.          srcStepY.i := divFix(points[nextVert].y - srcY.si, scansLeft);
  166.          dstX       := vertex[StartVert].X;
  167.          dstXWidth  := vertex[NextVert].X-vertex[StartVert].X;
  168.  
  169.          if (dstXWidth < 0) Then
  170.          begin
  171.            dstXdir     := -1;
  172.            dstXWidth   := -dstXWidth;
  173.            dstXErrTerm := 1 - scansLeft;
  174.            dstXIntStep := -(dstXWidth Div scansLeft);
  175.          end
  176.          else
  177.          begin
  178.            dstXdir     := 1;
  179.            dstXErrTerm := 0;
  180.            dstXIntStep := dstXWidth Div scansLeft;
  181.          end;
  182.          dstXAdjUp   := dstXWidth Mod scansLeft;
  183.          dstXAdjDown := scansLeft;
  184.          Exit;
  185.        end;
  186.        StartVert := NextVert;
  187.       end;
  188.     end;
  189.     SetUpEdge := False;
  190.   end;
  191.  
  192.   Function StepEdge(Var Edge : EdgeScan) : Boolean;
  193.   begin
  194.     Dec(Edge.scansLeft);
  195.     if (Edge.scansLeft = 0) Then
  196.     begin
  197.       StepEdge := SetUpEdge(Edge, Edge.Currentend);
  198.       Exit;
  199.     end;
  200.     With Edge Do
  201.     begin
  202.       Inc(srcX.i, srcStepX.i);
  203.       Inc(srcY.i, srcStepY.i);
  204.       Inc(dstX, dstXIntStep);
  205.       Inc(dstXErrTerm, dstXAdjUp);
  206.       if (dstXErrTerm > 0) Then
  207.       begin
  208.         Inc(dstX, dstXdir);
  209.         Dec(dstXErrTerm, dstXAdjDown);
  210.       end;
  211.     end;
  212.     StepEdge := True;
  213.   end;
  214.  
  215.   Procedure ScanOutLine;
  216.   Var
  217.     srcX,
  218.     srcY     : fixed;
  219.     dstX,
  220.     dstXMax  : Integer;
  221.     dstWidth,
  222.     srcXStep,
  223.     srcYStep : fixed;
  224.   begin
  225.     srcX.w  := lfEdge.srcX.w;
  226.     srcY.w  := lfEdge.srcY.w;
  227.     dstX    := lfEdge.dstX;
  228.     dstXMax := rtEdge.dstX;
  229.  
  230.     if (dstXMax <= ClipMinX) Or (dstX >= ClipMaxX) Then
  231.       Exit;
  232.     dstWidth.f  := 0;
  233.     dstWidth.si := dstXMax - dstX;
  234.     if (dstWidth.i <= 0) Then
  235.       Exit;
  236.     srcXStep.i := divFix(rtEdge.srcX.i - srcX.i, dstWidth.i);
  237.     srcYStep.i := divFix(rtEdge.srcY.i - srcY.i, dstWidth.i);
  238.     if (dstXMax > ClipMaxX) Then
  239.       dstXMax := ClipMaxX;
  240.     if (dstX < ClipMinX) Then
  241.     begin
  242.       Inc(srcX.i, srcXStep.i * (ClipMinX - dstX));
  243.       Inc(srcY.i, srcYStep.i * (ClipMinX - dstX));
  244.       dstX := ClipMinX;
  245.     end;
  246.  
  247.     Asm
  248.      mov  ax, $A000
  249.      mov  es, ax
  250.      mov  ax, xRes
  251.      mul  dstY
  252.      add  ax, dstX
  253.      mov  di, ax
  254.      mov  cx, dstXMax
  255.      sub  cx, dstX
  256.      mov  bx, srcXStep.i
  257.      mov  dx, srcYStep.i
  258.     @L:
  259.      mov  al, srcY.&si
  260.      xor  ah, ah
  261.      shl  ax, 3
  262.      add  al, srcX.&si
  263.      add  ax, offset texmap
  264.      mov  si, ax
  265.      movsb
  266.      add  srcX.i,bx
  267.      add  srcY.i,dx
  268.      loop @L
  269.      end;
  270.    end;
  271.  
  272. begin
  273.   if (NumVerts < 3) Then
  274.     Exit;
  275.   MinY := vertex[numVerts - 1].y;
  276.   maxY := vertex[numVerts - 1].y;
  277.   maxVert := numVerts - 1;
  278.   minVert := numVerts - 1;
  279.   For I := numVerts - 2 downto 0 Do
  280.   begin
  281.     if (vertex[I].Y < MinY) Then
  282.     begin
  283.       MinY    := vertex[I].Y;
  284.       MinVert := I;
  285.     end;
  286.     if (vertex[I].Y > MaxY) Then
  287.     begin
  288.       MaxY    := vertex[I].Y;
  289.       MaxVert := I;
  290.     end;
  291.   end;
  292.   if (MinY >= MaxY) Then
  293.     Exit;
  294.   dstY := MinY;
  295.   lfEdge.dir := -1;
  296.   SetUpEdge(lfEdge, MinVert);
  297.   rtEdge.dir := 1;
  298.   SetUpEdge(rtEdge, MinVert);
  299.   While (dstY < ClipMaxY) Do
  300.   begin
  301.     if (dstY >= ClipMinY) Then
  302.       ScanOutLine;
  303.     if Not StepEdge(lfEdge) Then
  304.       Exit;
  305.     if Not StepEdge(rtEdge) Then
  306.       Exit;
  307.     Inc(dstY);
  308.   end;
  309. end;
  310.  
  311. begin
  312.   directVideo := False;
  313.   TextAttr    := 63;
  314.   { For z:=0 to mapY do For z2:=0 to mapx do texMap[z,z2]:=random(6+53);}
  315.   For z := 4 to 38 do
  316.   begin
  317.     clearGraph;
  318.     vertex[0].x := z * 4;
  319.     vertex[3].x := z * 4;
  320.     draw;
  321.     if KeyPressed then
  322.     begin
  323.       ReadKey;
  324.       ReadKey;
  325.     end;
  326.   end;
  327.   readln;
  328. end.
  329.  
  330.